home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD Classic 39
/
CD CLASSIC #39 (1998).iso
/
EMPRESA
/
visio
/
Vistdstd
/
Install
/
Data.Z
/
Mainwnd.FRM
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1996-10-31
|
21KB
|
520 lines
VERSION 4.00
Begin VB.Form frmMainWindow
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Visio Inventory"
ClientHeight = 6000
ClientLeft = 3330
ClientTop = 3720
ClientWidth = 8535
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 6690
Icon = "MAINWND.frx":0000
Left = 3270
LinkTopic = "Form2"
MaxButton = 0 'False
ScaleHeight = 6000
ScaleWidth = 8535
Top = 3090
Width = 8655
Begin Threed.SSPanel ctlStatusLine
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 2
Top = 5625
Width = 8535
_Version = 65536
_ExtentX = 15055
_ExtentY = 661
_StockProps = 15
Caption = "Ready"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BevelInner = 1
RoundedCorners = 0 'False
Font3D = 3
Alignment = 1
End
Begin VB.ComboBox ctlPageList
Appearance = 0 'Flat
Height = 300
Left = 1260
Style = 2 'Dropdown List
TabIndex = 4
Top = 480
Width = 2715
End
Begin VB.ComboBox ctlDocList
Appearance = 0 'Flat
Height = 300
Left = 1260
Style = 2 'Dropdown List
TabIndex = 3
Top = 120
Width = 2715
End
Begin VB.ComboBox ctlSortField
Appearance = 0 'Flat
Height = 300
Left = 1260
Style = 2 'Dropdown List
TabIndex = 1
Top = 840
Width = 2715
End
Begin Threed.SSPanel Panel3D1
Height = 5655
Left = 0
TabIndex = 5
Top = 0
Width = 8535
_Version = 65536
_ExtentX = 15055
_ExtentY = 9975
_StockProps = 15
BevelInner = 1
Begin MSGrid.Grid ctlQueryGrid
Height = 4275
Left = 120
TabIndex = 0
Top = 1200
Width = 8235
_Version = 65536
_ExtentX = 14526
_ExtentY = 7541
_StockProps = 77
BackColor = -2147483643
Cols = 9
FixedCols = 0
End
Begin Threed.SSCommand btnReQuery
Height = 1035
Left = 6780
TabIndex = 10
Top = 120
Width = 1575
_Version = 65536
_ExtentX = 2778
_ExtentY = 1826
_StockProps = 78
Caption = "ReQuery Visio"
Picture = "MAINWND.frx":030A
End
Begin Threed.SSCommand btnChooseFields
Height = 1035
Left = 5100
TabIndex = 9
Top = 120
Width = 1575
_Version = 65536
_ExtentX = 2778
_ExtentY = 1826
_StockProps = 78
Caption = "Choose Fields"
Picture = "MAINWND.frx":0624
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Sort Field:"
ForeColor = &H80000008&
Height = 195
Left = 300
TabIndex = 7
Top = 900
Width = 915
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Page:"
ForeColor = &H80000008&
Height = 195
Left = 420
TabIndex = 8
Top = 540
Width = 795
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Document:"
ForeColor = &H80000008&
Height = 195
Left = 180
TabIndex = 6
Top = 180
Width = 1035
End
Begin VB.Shape Shape1
BackColor = &H00000000&
BackStyle = 1 'Opaque
Height = 4275
Left = 180
Top = 1260
Width = 8235
End
End
Begin VB.Menu FileMenu
Caption = "&File"
Begin VB.Menu FileExport
Caption = "&Export"
Shortcut = ^S
End
Begin VB.Menu FileSep
Caption = "-"
End
Begin VB.Menu FilePrint
Caption = "&Print"
Enabled = 0 'False
End
Begin VB.Menu FilePrinterSetup
Caption = "Pri&nter Setup"
Enabled = 0 'False
End
Begin VB.Menu FilePageSetup
Caption = "Page Se&tup"
Enabled = 0 'False
End
Begin VB.Menu FileSep2
Caption = "-"
End
Begin VB.Menu FileExit
Caption = "E&xit"
End
End
Begin VB.Menu EditMenu
Caption = "&Edit"
Begin VB.Menu EditCopy
Caption = "&Copy"
Enabled = 0 'False
Shortcut = ^{INSERT}
End
Begin VB.Menu EditSep1
Caption = "-"
End
Begin VB.Menu EditSelectAll
Caption = "&Select All"
End
End
Begin VB.Menu OptionsMenu
Caption = "&Options"
Begin VB.Menu ExportSetup
Caption = "E&xport Setup"
End
End
Begin VB.Menu HelpMenu
Caption = "&Help"
Begin VB.Menu HelpContents
Caption = "&Contents"
Enabled = 0 'False
Shortcut = {F1}
End
Begin VB.Menu HelpSearch
Caption = "&Search For Help On"
Enabled = 0 'False
End
Begin VB.Menu HelpSep
Caption = "-"
End
Begin VB.Menu HelpAbout
Caption = "&About"
End
End
Attribute VB_Name = "frmMainWindow"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' -----------------------------------------------------------------------------
' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
' You have a royalty-free right to use, modify, reproduce and distribute
' the Sample Application Files (and/or any modified version) in any way
' you find useful, provided that you agree that Visio has no warranty,
' obligations or liability for any Sample Application Files.
' -----------------------------------------------------------------------------
Option Explicit '-- All Variable Explicit
Dim iSortIndex As Integer '-- Sort Field Index
Dim iPageIndex As Integer '-- Current Page Index
Dim iDocIndex As Integer '-- Current Document Index
Private Sub btnChooseFields_Click()
'------------------------------------
'--- btnChooseFields_Click ----------
'-- When the Choose Fields is chosen we load the Choose Fields form. After
'-- It's done we re-paint the query grid to take into account any changes made.
frmChooseFields.Show 1
If Not GetIncludeFlag(iSortIndex) Then
iSortIndex = 0
End If
UpdateFieldsList
RePaint
End Sub
Private Sub btnReQuery_Click()
'------------------------------------
'--- btnReQuery_Click ---------------
'-- When the user presses this button we just want to requery the database.
UpdateDatabase
End Sub
Private Sub ctlDocList_Click()
'------------------------------------
'--- ctlDocList_Click ---------------
'-- When the user clicks a document name we check to see if it's different
'-- than our internal index iDocIndex. If so we update the page list and the
'-- internal index.
If iDocIndex <> ctlDocList.ListIndex Then '-- If Different Indexes...
iDocIndex = ctlDocList.ListIndex '-- Update Internal Index
Call UpdatePageList '-- Update Page List
End If
End Sub
Private Sub ctlPageList_Click()
'------------------------------------
'--- ctlDocList_Change --------------
'-- When the user clicks a page name we check to see if it's different
'-- than our internal index iPageIndex. If so we requery the database and
'-- size the columns.
If iPageIndex <> ctlPageList.ListIndex Then
iPageIndex = ctlPageList.ListIndex '-- Update Page Index
ReQuery CurDocIndex(), CurPageIndex()
RePaint
End If
End Sub
Private Sub ctlQueryGrid_SelChange()
'------------------------------------
'--- ctlQueryGrid_SelChange ---------
If (ctlQueryGrid.SelEndCol >= ctlQueryGrid.SelStartCol) Then
If (ctlQueryGrid.SelEndRow >= ctlQueryGrid.SelStartRow) Then
EditCopy.Enabled = True
Exit Sub
End If
End If
EditCopy.Enabled = False
End Sub
Private Sub ctlSortField_Click()
'------------------------------------
'--- cstSortField_Click -------------
'-- When the user clicks a sort field name we check to see if it's different
'-- than our internal index iSortIndex. If so we process the change and update
'-- the internal index.
If iSortIndex <> ctlSortField.ListIndex Then
iSortIndex = ctlSortField.ListIndex
SetSort iSortIndex
RePaint
End If
End Sub
Private Function CurDocIndex() As Integer
'------------------------------------
'--- CurDocIndex --------------------
'-- Simply returns the collection index of the current document. Note, it
'-- returns the collection index, not the control index.
Dim iIndex As Integer
iIndex = ctlDocList.ListIndex
CurDocIndex = GetCollIndex(iIndex)
End Function
Private Function CurPageIndex() As Integer
'------------------------------------
'--- CurPageIndex -------------------
'-- Simply returns the index of the current page. However, it returns the
'-- collection index, not the page controls index.
CurPageIndex = ctlPageList.ListIndex + 1 '-- Return Index
End Function
Private Sub EditCopy_Click()
'------------------------------------
'--- EditCopy_Click -----------------
'-- Copies the highlighted selection on the grid to the clipboard.
Dim iRow As Integer, iCol As Integer, Temp As String
Dim iOldRow As Integer, iOldCol As Integer
Dim sFieldSep As String
sFieldSep = g_FieldSeps(g_iFieldSepIdx)
iOldRow = ctlQueryGrid.Row '-- Save Last Row And Column
iOldCol = ctlQueryGrid.Col
If g_bIncFieldNames Then '-- Include Field Names
ctlQueryGrid.Row = 0 '-- Move To Field Row
For iCol = ctlQueryGrid.SelStartCol To ctlQueryGrid.SelEndCol
ctlQueryGrid.Col = iCol
If iCol <> ctlQueryGrid.SelStartCol Then
Temp = Temp + sFieldSep
End If
Temp = Temp + ApplyTextDel(ctlQueryGrid.Text)
Next iCol
Temp = Temp + Chr$(13) + Chr$(10) '-- Append CR/LF
End If
For iRow = ctlQueryGrid.SelStartRow To ctlQueryGrid.SelEndRow
ctlQueryGrid.Row = iRow
For iCol = ctlQueryGrid.SelStartCol To ctlQueryGrid.SelEndCol
ctlQueryGrid.Col = iCol
If iCol <> ctlQueryGrid.SelStartCol Then
Temp = Temp + sFieldSep
End If
Temp = Temp + ApplyTextDel(ctlQueryGrid.Text)
Next iCol
Temp = Temp + Chr$(13) + Chr$(10) '-- Append CR/LF
Next iRow
ctlQueryGrid.Row = iOldRow '-- Restore Last Row And Column
ctlQueryGrid.Col = iOldCol
Clipboard.Clear '-- Clear Clipboard Contents
Clipboard.SetText Temp '-- Put Text On Clipboard
End Sub
Private Sub EditSelectAll_Click()
'------------------------------------
'--- EditSelectAll_Click ------------
'-- Selects all data on the grid.
ctlQueryGrid.SelStartCol = ctlQueryGrid.FixedCols
ctlQueryGrid.SelStartRow = ctlQueryGrid.FixedRows
ctlQueryGrid.SelEndCol = ctlQueryGrid.Cols - 1
ctlQueryGrid.SelEndRow = ctlQueryGrid.Rows - 1
End Sub
Private Sub ExportSetup_Click()
'------------------------------------
'--- ExportSetup_Click --------------
'-- Displays the export setup dialog.
frmExportSetup.Show 1
End Sub
Private Sub FileExit_Click()
'------------------------------------
'--- FileExit_Click -----------------
'-- When the user chooses to quit we unload the main form and end.
Unload frmMainWindow '-- Unload Main Frame
End '-- End Program
End Sub
Private Sub FileExport_Click()
'------------------------------------
'--- FileExport_Click ---------------
On Error GoTo ExportErrHandler
Dim Temp As String
Const OFN_HIDEREADONLY = &H4&
Const OFN_OVERWRITEPROMPT = &H2&
frmSaveAs.CMDialog1.CancelError = True
frmSaveAs.CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
frmSaveAs.CMDialog1.Action = 2
Temp = frmSaveAs.CMDialog1.filename
ExportToFile Temp
Exit Sub
ExportErrHandler:
Exit Sub
Resume Next
End Sub
Private Sub Form_Activate()
'------------------------------------
'--- frmMainWindow:Form_Activate ----
'-- When the window is activated we always update the database in case the
'-- user has made any changes in Visio. Need to add a flag to not update after
'-- internal form changes.
'Remmed by TDS - must check for internal activates (i.e. About form unloaded)
'UpdateDatabase '-- Update Database Lists
End Sub
Private Sub Form_Load()
'------------------------------------
'--- frmMainWindow:Form_Load --------
'-- Handles application initialization. All we do at first is update the
'-- field list. The document and page lists should be handled by the window
'-- Activate event.
iSortIndex = 0 '-- Default To Name Sort
iDocIndex = -1 '-- Default To No Doc
iPageIndex = -1 '-- Default To No Page
EditCopy.Enabled = False '-- Disable Copy Option
InitExportOptions '-- Initialize Export Vars
UpdateFieldsList '-- Update Sort Field List
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub HelpAbout_Click()
frmAboutDialog.Show 1 '-- Show Help About
End Sub
Private Sub UpdateDatabase()
'------------------------------------
'--- UpdateDatabase -----------------
'-- Updates the internal database of valid Visio document which are loaded.
'-- Should be called whenever the focus is set or application is activated to
'-- make sure the controls reflect Visio's open documents. Only call
'-- UpdateDocList because it's click event updates the page list anyways.
StatusLineMsg "Querying Visio Documents..."
UpdateValidDocList '-- Update Valid Documents
StatusLineMsg "Updating Document List..."
UpdateDocList '-- Update Document List Box
ClearStatusLine
End Sub
Private Sub UpdateDocList()
'------------------------------------
'--- UpdateDocList ------------------
'-- Handles updating the document drop down list on the main form. Uses the
'-- Valid Document Interface for retrieving document names. By setting
'-- the list box index we guarantee a Click event will occur and iDocIndex
'-- to be updated by the boxes Click handler. When this happens it chains
'-- down to the page list as well.
Dim I As Integer
iDocIndex = -1 '-- Force ReQuery
ctlDocList.Clear '-- Clear Document List
StatusLineMsg "Updating Document List..." '-- Update Status Line
If DocCount() > 0 Then '-- Any Documents...
For I = 0 To DocCount() - 1 '-- Loop Through Docs...
ctlDocList.AddItem StripPath(GetDocName(I)) '-- Add Name
Next I
ctlDocList.ListIndex = 0 '-- Select First Document
'-- And Get
Else
ctlDocList.ListIndex = -1 '-- No Doc Selected
End If
ClearStatusLine '-- Clear Status Line
End Sub
Private Sub UpdateFieldsList()
'------------------------------------
'--- UpdateFieldsList ---------------
'-- Fills in the main form's Sort Field list box.
Dim I As Integer
ctlSortField.Clear '-- Clear List
For I = 0 To IncludeCount() - 1 '-- Loop Through Used Fields...
ctlSortField.AddItem IncludeNames(I) '-- Add Next Field Name
Next I
ctlSortField.ListIndex = 0 '-- Select First Field
End Sub
Private Sub UpdatePageList()
'------------------------------------
'--- UpdatePageList -----------------
'-- Updates the page drop down list names. Uses the Valid Document Interface
'-- to retrieve the current document. By setting the page index to -1 we force
'-- a requery when the list box's Click handler gets called.
Dim I As Integer, iPageCount As Integer, iCurDoc As Integer
Dim pagsPageList As Visio.Pages, docCurDoc As Visio.DOCUMENT
iPageIndex = -1 '-- Force ReQuery
ctlPageList.Clear '-- Clear Page List
iCurDoc = ctlDocList.ListIndex '-- Get Current Doc Index
If iCurDoc = -1 Then Exit Sub '-- If No Document Exit
StatusLineMsg "Updating Page List..." '-- Updating Page List
iCurDoc = GetCollIndex(iCurDoc) '-- Get Collection Index
AppConnect
Set docCurDoc = g_appVisio.Documents(iCurDoc) '-- Get Current Document
iPageCount = docCurDoc.Pages.Count '-- Get Page Count
If iPageCount > 0 Then '-- Any Documents....
Set pagsPageList = docCurDoc.Pages '-- Get Page List
For I = 1 To iPageCount '-- Loop Through Pages...
ctlPageList.AddItem pagsPageList(I).Name '-- Add Name
Next I
ctlPageList.ListIndex = 0 '-- Set To Active Doc
Else
ctlPageList.ListIndex = -1 '-- No Selection
End If
ClearStatusLine '-- Clear Status Line
End Sub